<%
Class AES
  Private cls_lOnBits(30), cls_l2Power(30), cls_bytOnBits(7),cls_byt2Power(7)
  Private cls_InCo(3)
  Private cls_fbsub(255), cls_rbsub(255), cls_ptab(255), cls_ltab(255), cls_ftable(255), cls_rtable(255), cls_rco(29)
  Private cls_Nk, cls_Nb, cls_Nr
  Private cls_fi(23), cls_ri(23), cls_fkey(119), cls_rkey(119)
  Private Sub Class_Initialize()
      cls_InCo(0) = &HB
      cls_InCo(1) = &HD
      cls_InCo(2) = &H9
      cls_InCo(3) = &HE
      cls_bytOnBits(0) = 1
      cls_bytOnBits(1) = 3
      cls_bytOnBits(2) = 7
      cls_bytOnBits(3) = 15
      cls_bytOnBits(4) = 31
      cls_bytOnBits(5) = 63
      cls_bytOnBits(6) = 127
      cls_bytOnBits(7) = 255
  
      cls_byt2Power(0) = 1
      cls_byt2Power(1) = 2
      cls_byt2Power(2) = 4
      cls_byt2Power(3) = 8
      cls_byt2Power(4) = 16
      cls_byt2Power(5) = 32
      cls_byt2Power(6) = 64
      cls_byt2Power(7) = 128
  
      cls_lOnBits(0) = 1
      cls_lOnBits(1) = 3
      cls_lOnBits(2) = 7
      cls_lOnBits(3) = 15
      cls_lOnBits(4) = 31
      cls_lOnBits(5) = 63
      cls_lOnBits(6) = 127
      cls_lOnBits(7) = 255
      cls_lOnBits(8) = 511
      cls_lOnBits(9) = 1023
      cls_lOnBits(10) = 2047
      cls_lOnBits(11) = 4095
      cls_lOnBits(12) = 8191
      cls_lOnBits(13) = 16383
      cls_lOnBits(14) = 32767
      cls_lOnBits(15) = 65535
      cls_lOnBits(16) = 131071
      cls_lOnBits(17) = 262143
      cls_lOnBits(18) = 524287
      cls_lOnBits(19) = 1048575
      cls_lOnBits(20) = 2097151
      cls_lOnBits(21) = 4194303
      cls_lOnBits(22) = 8388607
      cls_lOnBits(23) = 16777215
      cls_lOnBits(24) = 33554431
      cls_lOnBits(25) = 67108863
      cls_lOnBits(26) = 134217727
      cls_lOnBits(27) = 268435455
      cls_lOnBits(28) = 536870911
      cls_lOnBits(29) = 1073741823
      cls_lOnBits(30) = 2147483647
  
      cls_l2Power(0) = 1
      cls_l2Power(1) = 2
      cls_l2Power(2) = 4
      cls_l2Power(3) = 8
      cls_l2Power(4) = 16
      cls_l2Power(5) = 32
      cls_l2Power(6) = 64
      cls_l2Power(7) = 128
      cls_l2Power(8) = 256
      cls_l2Power(9) = 512
      cls_l2Power(10) = 1024
      cls_l2Power(11) = 2048
      cls_l2Power(12) = 4096
      cls_l2Power(13) = 8192
      cls_l2Power(14) = 16384
      cls_l2Power(15) = 32768
      cls_l2Power(16) = 65536
      cls_l2Power(17) = 131072
      cls_l2Power(18) = 262144
      cls_l2Power(19) = 524288
      cls_l2Power(20) = 1048576
      cls_l2Power(21) = 2097152
      cls_l2Power(22) = 4194304
      cls_l2Power(23) = 8388608
      cls_l2Power(24) = 16777216
      cls_l2Power(25) = 33554432
      cls_l2Power(26) = 67108864
      cls_l2Power(27) = 134217728
      cls_l2Power(28) = 268435456
      cls_l2Power(29) = 536870912
      cls_l2Power(30) = 1073741824
  End Sub
  Private Function ByteSub(x)
      Dim y, z
  
      z = x
      y = cls_ptab(255 - cls_ltab(z))
      z = y
      z = ROTLB(z, 1)
      y = y Xor z
      z = ROTLB(z, 1)
      y = y Xor z
      z = ROTLB(z, 1)
      y = y Xor z
      z = ROTLB(z, 1)
      y = y Xor z
      y = y Xor &H63
  
      ByteSub = y
  End Function
  Private Function SHL(lValue, iShiftBits)
      If iShiftBits = 0 Then
          SHL = lValue
          Exit Function
      ElseIf iShiftBits = 31 Then
          If lValue And 1 Then
              SHL = &H80000000
          Else
              SHL = 0
          End If
          Exit Function
      ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
          Err.Raise 6
      End If
  
      If (lValue And cls_l2Power(31 - iShiftBits)) Then
          SHL = ((lValue And cls_lOnBits(31 - (iShiftBits + 1))) * cls_l2Power(iShiftBits)) Or &H80000000
      Else
          SHL = ((lValue And cls_lOnBits(31 - iShiftBits)) * cls_l2Power(iShiftBits))
      End If
  End Function
  Private Function SHR(lValue, iShiftBits)
      If iShiftBits = 0 Then
          SHR = lValue
          Exit Function
      ElseIf iShiftBits = 31 Then
          If lValue And &H80000000 Then
              SHR = 1
          Else
              SHR = 0
          End If
          Exit Function
      ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
          Err.Raise 6
      End If
  
      SHR = (lValue And &H7FFFFFFE) \ cls_l2Power(iShiftBits)
  
      If (lValue And &H80000000) Then
          SHR = (SHR Or (&H40000000 \ cls_l2Power(iShiftBits - 1)))
      End If
  End Function
  Private Function SHLB(bytValue, bytShiftBits)
      If bytShiftBits = 0 Then
          SHLB = bytValue
          Exit Function
      ElseIf bytShiftBits = 7 Then
          If bytValue And 1 Then
              SHLB = &H80
          Else
              SHLB = 0
          End If
          Exit Function
      ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then
          Err.Raise 6
      End If
  
      SHLB = ((bytValue And cls_bytOnBits(7 - bytShiftBits)) * cls_byt2Power(bytShiftBits))
  End Function
  Private Function SHRB(bytValue, bytShiftBits)
      If bytShiftBits = 0 Then
          SHRB = bytValue
          Exit Function
      ElseIf bytShiftBits = 7 Then
          If bytValue And &H80 Then
              SHRB = 1
          Else
              SHRB = 0
          End If
          Exit Function
      ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then
          Err.Raise 6
      End If
  
      SHRB = bytValue \ cls_byt2Power(bytShiftBits)
  End Function
  Private Function ROTL(lValue, iShiftBits)
      ROTL = SHL(lValue, iShiftBits) Or SHR(lValue, (32 - iShiftBits))
  End Function
  Private Function ROTLB(bytValue, bytShiftBits)
      ROTLB = SHLB(bytValue, bytShiftBits) Or SHRB(bytValue, (8 - bytShiftBits))
  End Function
  Private Function Pack(b())
      Dim lCount
      Dim lTemp
  
      For lCount = 0 To 3
          lTemp = b(lCount)
          Pack = Pack Or SHL(lTemp, (lCount * 8))
      Next
  End Function
  Private Function PackFrom(b(), k)
      Dim lCount
      Dim lTemp
  
      For lCount = 0 To 3
          lTemp = b(lCount + k)
          PackFrom = PackFrom Or SHL(lTemp, (lCount * 8))
      Next
  End Function
  Private Sub Unpack(a, b())
      b(0) = a And cls_lOnBits(7)
      b(1) = SHR(a, 8) And cls_lOnBits(7)
      b(2) = SHR(a, 16) And cls_lOnBits(7)
      b(3) = SHR(a, 24) And cls_lOnBits(7)
  End Sub
  Private Sub UnpackFrom(a, ByRef b(), k)
      b(0 + k) = a And cls_lOnBits(7)
      b(1 + k) = SHR(a, 8) And cls_lOnBits(7)
      b(2 + k) = SHR(a, 16) And cls_lOnBits(7)
      b(3 + k) = SHR(a, 24) And cls_lOnBits(7)
  End Sub
  Private Function IsInitialized(ByVal a_aArray)
      On Error Resume Next
      IsInitialized = IsNumeric(UBound(a_aArray))
  End Function
  Private Sub CopyBytesASP(bytDest, lDestStart, bytSource(), lSourceStart, lLength)
      Dim lCount
  
      lCount = 0

      Do
          bytDest(lDestStart + lCount) = bytSource(lSourceStart + lCount)
          lCount = lCount + 1
      Loop Until lCount = lLength
  End Sub
  Private Function xtime(a)
      Dim b
  
      If (a And &H80) Then
          b = &H1B
      Else
          b = 0
      End If
  
      xtime = SHLB(a, 1)
      xtime = xtime Xor b
  End Function
  Private Function bmul(x, y)
      If x <> 0 And y <> 0 Then
          bmul = cls_ptab((CLng(cls_ltab(x)) + CLng(cls_ltab(y))) Mod 255)
      Else
          bmul = 0
      End If
  End Function
  Private Function SubByte(a)
      Dim b(3)
  
      Unpack a, b
      b(0) = cls_fbsub(b(0))
      b(1) = cls_fbsub(b(1))
      b(2) = cls_fbsub(b(2))
      b(3) = cls_fbsub(b(3))
  
      SubByte = Pack(b)
  End Function
  Private Function product(x, y)
      Dim xb(3), yb(3)
  
      Unpack x, xb
      Unpack y, yb
      product = bmul(xb(0), yb(0)) Xor bmul(xb(1), yb(1)) Xor bmul(xb(2), yb(2)) Xor bmul(xb(3), yb(3))
  End Function
  Private Function InvMixCol(x)
      Dim y, m
      Dim b(3)
  
      m = Pack(cls_InCo)
      b(3) = product(m, x)
      m = ROTL(m, 24)
      b(2) = product(m, x)
      m = ROTL(m, 24)
      b(1) = product(m, x)
      m = ROTL(m, 24)
      b(0) = product(m, x)
      y = Pack(b)
  
      InvMixCol = y
  End Function
  Public Sub gentables()
      Dim i, y, ib
      Dim b(3)
  
      cls_ltab(0) = 0
      cls_ltab(1) = 0
      cls_ltab(3) = 1
      cls_ptab(0) = 1
      cls_ptab(1) = 3
  
      For i = 2 To 255
          cls_ptab(i) = cls_ptab(i - 1) Xor xtime(cls_ptab(i - 1))
          cls_ltab(cls_ptab(i)) = i
      Next
  
      cls_fbsub(0) = &H63
      cls_rbsub(&H63) = 0
  
      For i = 1 To 255
          ib = i
          y = ByteSub(ib)
          cls_fbsub(i) = y
          cls_rbsub(y) = i
      Next
  
      y = 1
      For i = 0 To 29
          cls_rco(i) = y
          y = xtime(y)
      Next
  
      For i = 0 To 255
          y = cls_fbsub(i)
          b(3) = y Xor xtime(y)
          b(2) = y
          b(1) = y
          b(0) = xtime(y)
          cls_ftable(i) = Pack(b)
          y = cls_rbsub(i)
          b(3) = bmul(cls_InCo(0), y)
          b(2) = bmul(cls_InCo(1), y)
          b(1) = bmul(cls_InCo(2), y)
          b(0) = bmul(cls_InCo(3), y)
          cls_rtable(i) = Pack(b)
      Next
  End Sub
  Private Sub gkey(nb, nk, key())                
      Dim i, j, k, m, n
      Dim C1, C2, C3
      Dim CipherKey(7)
  
      cls_Nb = nb
      cls_Nk = nk
  
      If cls_Nb >= cls_Nk Then
          cls_Nr = 6 + cls_Nb
      Else
          cls_Nr = 6 + cls_Nk
      End If
  
      C1 = 1
      If cls_Nb < 8 Then
          C2 = 2
          C3 = 3
      Else
          C2 = 3
          C3 = 4
      End If
  
      For j = 0 To nb - 1
          m = j * 3
      
          cls_fi(m) = (j + C1) Mod nb
          cls_fi(m + 1) = (j + C2) Mod nb
          cls_fi(m + 2) = (j + C3) Mod nb
          cls_ri(m) = (nb + j - C1) Mod nb
          cls_ri(m + 1) = (nb + j - C2) Mod nb
          cls_ri(m + 2) = (nb + j - C3) Mod nb
      Next
  
      N = cls_Nb * (cls_Nr + 1)
  
      For i = 0 To cls_Nk - 1
          j = i * 4
          CipherKey(i) = PackFrom(key, j)
      Next
  
      For i = 0 To cls_Nk - 1
          cls_fkey(i) = CipherKey(i)
      Next
  
      j = cls_Nk
      k = 0

      Do While j < N
          cls_fkey(j) = cls_fkey(j - cls_Nk) Xor _
          SubByte(ROTL(cls_fkey(j - 1), 24)) Xor cls_rco(k)
  
          If cls_Nk <= 6 Then
              i = 1

              Do While i < cls_Nk And (i + j) < N
                  cls_fkey(i + j) = cls_fkey(i + j - cls_Nk) Xor _
                  cls_fkey(i + j - 1)
                  i = i + 1
              Loop
          Else
              i = 1
  
              Do While i < 4 And (i + j) < N
                  cls_fkey(i + j) = cls_fkey(i + j - cls_Nk) Xor _
                  cls_fkey(i + j - 1)
                  i = i + 1
              Loop

              If j + 4 < N Then
                  cls_fkey(j + 4) = cls_fkey(j + 4 - cls_Nk) Xor _
                  SubByte(cls_fkey(j + 3))
              End If
  
              i = 5

              Do While i < cls_Nk And (i + j) < N
                  cls_fkey(i + j) = cls_fkey(i + j - cls_Nk) Xor _
                  cls_fkey(i + j - 1)
                  i = i + 1
              Loop
          End If
      
          j = j + cls_Nk
          k = k + 1
      Loop
  
      For j = 0 To cls_Nb - 1
          cls_rkey(j + N - nb) = cls_fkey(j)
      Next
  
      i = cls_Nb

      Do While i < N - cls_Nb
          k = N - cls_Nb - i

          For j = 0 To cls_Nb - 1
              cls_rkey(k + j) = InvMixCol(cls_fkey(i + j))
          Next
  
          i = i + cls_Nb
      Loop
  
      j = N - cls_Nb

      Do While j < N
          cls_rkey(j - N + cls_Nb) = cls_fkey(j)
          j = j + 1
      Loop
  End Sub
  Private Sub EncryptData(buff())
      Dim i, j, k, m, x, y, t
      Dim a(7), b(7)
  
      For i = 0 To cls_Nb - 1
          j = i * 4
          a(i) = PackFrom(buff, j)
          a(i) = a(i) Xor cls_fkey(i)
      Next
  
      k = cls_Nb
      x = a
      y = b
  
      For i = 1 To cls_Nr - 1
          For j = 0 To cls_Nb - 1
              m = j * 3
              y(j) = cls_fkey(k) Xor cls_ftable(x(j) And cls_lOnBits(7)) Xor _
              ROTL(cls_ftable(SHR(x(cls_fi(m)), 8) And cls_lOnBits(7)), 8) Xor _
              ROTL(cls_ftable(SHR(x(cls_fi(m + 1)), 16) And cls_lOnBits(7)), 16) Xor _
              ROTL(cls_ftable(SHR(x(cls_fi(m + 2)), 24) And cls_lOnBits(7)), 24)
              k = k + 1
          Next
          t = x
          x = y
          y = t
      Next
  
      For j = 0 To cls_Nb - 1
          m = j * 3
          y(j) = cls_fkey(k) Xor cls_fbsub(x(j) And cls_lOnBits(7)) Xor _
          ROTL(cls_fbsub(SHR(x(cls_fi(m)), 8) And cls_lOnBits(7)), 8) Xor _
          ROTL(cls_fbsub(SHR(x(cls_fi(m + 1)), 16) And cls_lOnBits(7)), 16) Xor _
          ROTL(cls_fbsub(SHR(x(cls_fi(m + 2)), 24) And cls_lOnBits(7)), 24)
          k = k + 1
      Next
  
      For i = 0 To cls_Nb - 1
          j = i * 4
          UnpackFrom y(i), buff, j
          x(i) = 0
          y(i) = 0
      Next
  End Sub
  Private Sub DecryptData(buff())
      Dim i, j, k, m, x, y, t
      Dim a(7), b(7)
  
      For i = 0 To cls_Nb - 1
          j = i * 4
          a(i) = PackFrom(buff, j)
          a(i) = a(i) Xor cls_rkey(i)
      Next
  
      k = cls_Nb
      x = a
      y = b
  
      For i = 1 To cls_Nr - 1
          For j = 0 To cls_Nb - 1
              m = j * 3
              y(j) = cls_rkey(k) Xor cls_rtable(x(j) And cls_lOnBits(7)) Xor _
              ROTL(cls_rtable(SHR(x(cls_ri(m)), 8) And cls_lOnBits(7)), 8) Xor _
              ROTL(cls_rtable(SHR(x(cls_ri(m + 1)), 16) And cls_lOnBits(7)), 16) Xor _
              ROTL(cls_rtable(SHR(x(cls_ri(m + 2)), 24) And cls_lOnBits(7)), 24)
              k = k + 1
          Next
          t = x
          x = y
          y = t
      Next
  
      For j = 0 To cls_Nb - 1
          m = j * 3
          y(j) = cls_rkey(k) Xor cls_rbsub(x(j) And cls_lOnBits(7)) Xor _
          ROTL(cls_rbsub(SHR(x(cls_ri(m)), 8) And cls_lOnBits(7)), 8) Xor _
          ROTL(cls_rbsub(SHR(x(cls_ri(m + 1)), 16) And cls_lOnBits(7)), 16) Xor _
          ROTL(cls_rbsub(SHR(x(cls_ri(m + 2)), 24) And cls_lOnBits(7)), 24)
          k = k + 1
      Next
  
      For i = 0 To cls_Nb - 1
          j = i * 4
          UnpackFrom y(i), buff, j
          x(i) = 0
          y(i) = 0
      Next
  End Sub
  Public Function Encrypt(a_sMsg, a_sPassword)
      Dim bytKey(31)
      Dim bytTemp(31)
      Dim bytLen(3)
      Dim bytIn()
      Dim bytOut()
      Dim lCount, lLength, lEncodedLength, lPosition
      Dim bytMessage
      Dim sResult
      lLength = Len(a_sMsg)
      ReDim bytMessage(lLength-1)

      For lCount = 1 To lLength
          bytMessage(lCount-1)=CByte(AscB(Mid(a_sMsg,lCount,1)))
      Next
      lLength = Len(a_sPassword)
      ReDim bytPassword(lLength-1)
      For lCount = 1 To lLength
          bytPassword(lCount-1)=CByte(AscB(Mid(a_sPassword,lCount,1)))
      Next
      If Not IsInitialized(bytMessage) Then
          Exit Function
      End If

      If Not IsInitialized(bytPassword) Then
          Exit Function
      End If
      For lCount = 0 To UBound(bytPassword)
          bytKey(lCount) = bytPassword(lCount)
          If lCount = 31 Then
              Exit For
          End If
      Next
  
      Call genTables()
      Call gKey(8, 8, bytKey)
      lLength = UBound(bytMessage) + 1
      lEncodedLength = lLength + 4
  
      If lEncodedLength Mod 32 <> 0 Then
          lEncodedLength = lEncodedLength + 32 - (lEncodedLength Mod 32)
      End If
  
      ReDim bytIn(lEncodedLength - 1)
      ReDim bytOut(lEncodedLength - 1)
      Unpack lLength, bytIn
      CopyBytesASP bytIn, 4, bytMessage, 0, lLength
      For lCount = 0 To lEncodedLength - 1 Step 32
          CopyBytesASP bytTemp, 0, bytIn, lCount, 32
          EncryptData bytTemp
          CopyBytesASP bytOut, lCount, bytTemp, 0, 32
      Next
      sResult = ""

      For lCount = 0 To UBound(bytOut)
          sResult = sResult & Right("0" & Hex(bytOut(lCount)), 2)
      Next
      Encrypt = sResult
  End Function
  Public Function Decrypt(a_sIn, a_sPassword)
      Dim bytMessage(), bytOut()
      Dim bytKey(31), bytTemp(31), bytIn, bytPassword, bytLen(3)
      Dim lCount, lLength, lEncodedLength, lPosition
      Dim sResult, sMsg : sMsg = Trim(a_sIn)
      Dim iCount
      If sMsg="" Or IsEmpty(sMsg) Or IsNull(sMsg) Then
          Exit Function
      End If
      lLength = Len(sMsg)
      ReDim bytIn(lLength/2-1)
      iCount = 0
      
      For lCount = 1 To lLength Step 2
          bytIn(iCount) = CByte(Int("&H" & Mid(sMsg, lCount,2)))
          iCount = iCount + 1
      Next
      lLength = Len(a_sPassword)
      ReDim bytPassword(lLength-1)
      For lCount = 1 To lLength
          bytPassword(lCount-1)=CByte(AscB(Mid(a_sPassword,lCount,1)))
      Next
      If Not IsInitialized(bytIn) Then
          Exit Function
      End If
      If Not IsInitialized(bytPassword) Then
          Exit Function
      End If
      lEncodedLength = UBound(bytIn) + 1
      If Int(lEncodedLength) Mod 32 <> 0 Then
          Exit Function
      End If
  
      For lCount = 0 To UBound(bytPassword)
          bytKey(lCount) = bytPassword(lCount)
          If lCount = 31 Then
              Exit For
          End If
      Next
  
      Call genTables()
      Call gKey(8, 8, bytKey)
      ReDim bytOut(lEncodedLength - 1)

      For lCount = 0 To lEncodedLength - 1 Step 32
          CopyBytesASP bytTemp, 0, bytIn, lCount, 32
          DecryptData bytTemp
          CopyBytesASP bytOut, lCount, bytTemp, 0, 32
      Next
      lLength = Pack(bytOut)
      If lLength > lEncodedLength - 4 Then
          Exit Function
      End If
  
      ReDim bytMessage(lLength - 1)
      CopyBytesASP bytMessage, 0, bytOut, 4, lLength
      lLength = UBound(bytMessage)
      sResult = ""

      For lCount = 0 To lLength
          sResult = sResult & Chr(bytMessage(lCount))
      Next
      Decrypt = sResult
  End Function
End Class
%>
